COMMENT ⊗   VALID 00023 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	CRE3 -  CART'S EYE  -  CONTOUR,REGION,EDGE  -  BGB  -  APRIL 1973.
C00005 00003	INITIALIZATION - SA: AND REE:
C00007 00004	SUBR(TTY)	TTY LISTEN.
C00008 00005	  ---		COMMAND JUMP TABLE ASCII 00 TO 37.
C00009 00006	  ---		COMMAND JUMP TABLE ASCII 40 TO 77.
C00010 00007	  ---		COMMAND JUMP TABLE ASCII 100 TO 137.
C00012 00008	XWINDO:		WINDOW SCROLLING COMMANDS.
C00014 00009	XLINK:		LINK FOLLOWING COMMANDS.
C00016 00010	XRESET "Z" COMMAND.	 NEXIMG.
C00018 00011	SUBR(XMATCH)		"M" - MATCH AND LINK IMAGES IN TIME.
C00020 00012	SUBR(XNAME)		"N" - NAME THE FILM.
C00021 00013	XFLAGS:
C00023 00014	SUBR(XCUT).		MAKE CUTS COMMAND "C".
C00025 00015	SUBR(XATP1).	AUTOMATIC TURN TABLE PERCEPTION "A".
C00027 00016	SUBR(XATP2).	AUTOMATIC TURN TABLE PERCEPTION "εA".
C00029 00017	SUBR(XCUTS).		MAKE CUTS COMMAND "Q".
C00030 00018	SUBR(XTAKE).		"T" TAKE TELEVISION PICTURE.
C00031 00019	SUBR(XSELECT).		"S" SELECT CAMERA.
C00033 00020	SUBR(XXPAND)		HISTOGRAM CUT HIGH AND CUT LOW.
C00035 00021	SUBR(REMAP)		RE MAP TVBUF.
C00036 00022	AWIDTH - SELECT ARC WIDTH.
C00038 00023	XHELP:	CALL(TVHELP,[[SIXBIT/CRE/↔SIXBIT/HLP/↔0↔SIXBIT/GEM HE/]])
C00041 ENDMK
C⊗;
;CRE3 -  CART'S EYE  -  CONTOUR,REGION,EDGE  -  BGB  -  APRIL 1973.
TITLE CRE

	EXTERN QBLK,SX,SY,DEL,MAG
	EXTERN DPYBLK,DPYIMG,DPYHIS,CROP
	EXTERN MKCON
	EXTERN TVXGP,PLOTO,MORCOR
	EXTERN QIMAGE,QNODE

	INTERN FLGBGB,FLGDD,FLGIII
	INTERN CTRL,META,CHR
	INTERN ARCWID

;CONTROL FLAGS.
	INTERN FLGHIS
	FLGHIS:0		;HISTOGRAM IS VALID.
	VCUT↑:-14		;VECTOR DISPLAY CONTRAST THRESHOLD.
	PCUT↑:-14		;VECTOR COUNT.
	FLGBGB:0		;RUNNING UNDER A BGB PPPN.
	FLGDD:0			;RUNNING AT A DATA DISC.
	FLGIII:0		;RUNNING AT A III DISPLAY.

;ARC WIDTH PROPORTIONAL TO CONTRAST TABLE FOR MKARCS.
ARCWID:
	FOR I←0,3{1.0↔}
	FOR I←4,5{0.9↔}
	FOR I←6,12{0.8↔}
	FOR I←13,17{0.7↔}
	FOR I←20,37{0.6↔}
	FOR I←40,77{0.5↔}
	0

;TELETYPE COMMAND STATE.
	DECLARE{CTRL,META,MTCT,CHR}
;INITIALIZATION - SA: AND REE:
;----------------------------------------------------------------
	PDL: BLOCK 100

;START ADDRESS
SA:	LAC 17,[IOWD 100,PDL]
	CALL(MORCOR)
	CALL(SEGTV)
;RE-ENTRY ADDRESS.
REE:	LACI .↔DAC 124↔CALLI
	LAC 17,[IOWD 100,PDL]
	SETO↔GETLIN	;GET LINE CHARACTERISTICS.
	CAMN[-1]↔SETZ	;JOB DETACHED.
	DZM FLGIII↔TLNE(1B0)↔SETOM FLGIII
	DZM FLGDD↔ TLNE(1B4)↔SETOM FLGDD
	PPIOT 2,-=250
	PPIOT 3,3003
	DZM QBLK
	MOVEI 20↔CRLF↔SOJG .-1
	SETZ↔GETPPN↔CDR
	CAIN'BGB'↔SETOM FLGBGB
	LAC 17,[IOWD 100,PDL]
	CALL(CROP)
	CALL(DPYIMG)
	PUSHJ TTY
	EXIT
;6/12/72----------------------------------------------------------
;TELETYPE COMMAND STATE.

;SEGTV - GET OLD TVSEG.
SUBR(SEGTV)-------------------------------------------------------
	EXTERN HI
;MAKE A NEW TVSEG.
	LACI HI↔CORE2↔GO[FATAL(CAN'T GET A SECOND SEGMENT.)]
	LAC[SIXBIT/*CRE3*/]↔SETNM2↔JFCL
	SETZ↔SEGNUM↔DAC TVSEG
	LAC[%+1(%)]↔DZM %↔BLT HI-1
	POP0J
TVSEG:0
;16/12/72---------------------------------------------------------
SUBR(TTY)	;TTY LISTEN.
BEGIN TTY;--------------------------------------------------------
L0:	CRLF
L1:	OUTCHR["*"]
L2:	INCHRW
	DZM CTRL↔TRZE 200↔SETOM CTRL
	DZM META↔TRZE 400↔SETOM META
	CAIN 0,15↔GO L1+1	;CARRIAGE RETURN.
	CAIN 0,12↔GO L1		;LINE FEED.
	CAIL 140↔SUBI 40	;SUPPRESS LOWER CASE.
	DAC CHR
	LAC CTRL↔AND META↔DAC MTCT↔LAC CHR
	LAC 1,CHR
	PUSHJ P,@A00(1)
	GO L0			;CRLF-STAR.
	GO L2			;NOTHING.
	GO L1			;STAR.
BEND TTY; BGB 19 APRIL 1973 --------------------------------------
;  ---		COMMAND JUMP TABLE ASCII 00 TO 37.
A00:	NOP	;null
	NOP	;"↓"
	NOP	;"α"
	NOP	;"β"

	XLINK	;"∧"
	NOP	;"¬"
	NOP	;"ε"
	NOP	;"π"

	NOP	;"λ"
	NOP	;tab
	NOP	;lf
	NOP	;vt

	NOP	;ff
	NOP	;cr
	NOP	;"∞"
	NOP	;"∂"

	XLINK	;"⊂"
	XLINK	;"⊃"
	XLINK	;"∩"
	XLINK	;"∪"

	NOP	;"∀"
	NOP	;"∃"
	XLINK	;"⊗"
	XMOVIE	;"↔" RUN THRU THE IMAGES AS A MOVIE.

	NOP	;"_"
	XTDPY	;"→"
	NOP	;"~"
	NOP	;"≠"

	XLINK	;"≤"
	XLINK	;"≥"
	NOP	;"≡"
	XLINK	;"∨"

;  ---		COMMAND JUMP TABLE ASCII 40 TO 77.
A40:	XWINDO	;" "
	XLINK	;"!"
	NOP	;"""
	XCRLFS	;"#"

	NOP	;"$"
	NOP	;"%"
	NOP	;"&"
	NOP	;"'"

	XWINDO	;"("
	XWINDO	;")"
	XWINDO	;"*"
	XLINK	;"+"

	XLINK	;","
	XWINDO	;"-"
	XLINK	;"."
	XWINDO	;"/"

	NOP	;"0"
	NOP	;"1"
	NOP	;"2"
	NOP	;"3"

	NOP	;"4"
	NOP	;"5"
	NOP	;"6"
	NOP	;"7"

	NOP	;"8"
	NOP	;"9"
	XWINDO	;":"
	XWINDO	;";"

	XLINK	;"<"
	NOP	;"="
	XLINK	;">"
	XHELP	;"?"
;  ---		COMMAND JUMP TABLE ASCII 100 TO 137.

A100:	NOP		;"@"
	XATP1  		;"A" AUTOMATIC TURNTABLE PERCEPTION.
	NOP	        ;"B"
	XCUT  		;"C" MAKE THRESHOLD CUT.

	XFLAGS		;"D" DISABLE PROCESSES.
	XFLAGS		;"E" ENABLE PROCESSES.
	NOP	        ;"F"
	NOP		;"G"

	DPYHIS		;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
	XINPUT		;"I" INPUT.
	XXPAND		;"J" TWO CUTS AT 5% FROM ENDS.
	NOP		;"K"

	NOP	        ;"L"
	XMATCH		;"M" MATCH AND LINK IMAGES IN TIME.
	XNAME		;"N" NAME THE FILM.
	XOUTPUT		;"O" OUTPUT.

	PLOTO 		;"P" PLOT OUTPUT FILE.
	XCUTS 		;"Q" EQUI-SPACED CUTS.
	NOP	        ;"R"
	XSELECT		;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP.

	XTAKE		;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
	XTABLE↑		;"U" ENTER TURN TABLE SERVO SUB COMMAND.
	XVCUT		;"V"
	AWIDTH		;"W" SET ARC WIDTH TABLE.

	TVXGP		;"X"	XEROX OUTPUT.
	XTABLE↑		;"Y"	TURN TABLE.
	XRESET		;"Z"	ZERO DATA BUFFERS.
	NOP		;"[" OR "{"

	XWINDO		;"\" OR "|"
	NOP		;"]" OR ALT
	NOP		;"↑" OR "}"
	XTDPY		;"←" OR RUB

NOP:	OUTCHR[9]↔OUTCHR CHR↔OUTSTR[ASCIZ/ NO OPERATION./]
	POP0J
XWINDO:		;WINDOW SCROLLING COMMANDS.
BEGIN XWINDO;-----------------------------------------------------
	LAC CHR
	CAIN 0," "↔GO L2
	CAIN 0,":"↔GO[LAC SX↔FAD DEL↔DAC SX↔GO L2]
	CAIN 0,";"↔GO[LAC SX↔FSB DEL↔DAC SX↔GO L2]
	CAIN 0,")"↔GO[LAC SY↔FAD DEL↔DAC SY↔GO L2]
	CAIN 0,"("↔GO[LAC SY↔FSB DEL↔DAC SY↔GO L2]
	CAIN 0,"/"↔GO[LAC DEL↔FSC -1↔DAC DEL↔GO L2]
	CAIN 0,"\"↔GO[LAC DEL↔FSC 1↔DAC DEL↔GO L2]
	CAIN 0,"*"↔GO[LAC MAG↔FMP[1.5]↔DAC MAG↔GO L2]
	CAIN 0,"-"↔GO[LAC MAG↔FDV[1.5]↔DAC MAG↔GO L2]
L2:	CALL(CROP)↔CALL(DPYIMG)↔AOS(P)↔POP0J
BEND XWINDO; BGB 19 APRIL 1973 -----------------------------------

XVCUT:	SKIPE CTRL↔GO XVCUT2
	OUTSTR[ASCIZ/	VCUT = /]
	CALL(REALI)
	FIXX
	DAC VCUT
	CALL(DPYIMG)
	POP0J

XVCUT2:	OUTSTR[ASCIZ/	POLY SIDES = /]
	CALL(REALI)
	FIXX
	DAC PCUT
	CALL(DPYIMG)
	POP0J
XLINK:		;LINK FOLLOWING COMMANDS.

COMMENT/ Replace the QBLK with one of its own links. Empty links
and demands for positions that are not links are ignored by means
of checking the node's relocation bits./

BEGIN XLINK;------------------------------------------------------
	LAC CHR
	CAIN"!"↔GO[DZM QBLK↔GO L]
	CAIE"⊗"↔CAIN"+"↔GO[LAC FILM↔DAC QBLK↔GO L]
	SKIPN 2,QBLK↔POP0J		;GET THE QBLK NODE.
	RELOC 3,2		;RELOCATION BITS.
	CAIN","↔LACI 2000	;WORD0.
	CAIN"."↔LACI 1000
	CAIN"<"↔LACI 2001	;WORD1.
	CAIN">"↔LACI 1001
	CAIN"∪"↔LACI 2003	;WORD3.
	CAIN"∩"↔LACI 1003
	CAIN"≤"↔LACI 2004	;WORD4.
	CAIN"≥"↔LACI 1004
	CAIN"⊂"↔LACI 2005	;WORD5.
	CAIN"⊃"↔LACI 1005
	CAIN"∨"↔LACI 2006	;WORD6.
	CAIN"∧"↔LACI 1006
	TRNN 3000↔POP0J		;NO HIT ON COMMAND CHR.
	DAC 1↔ANDI 1,7↔LSH -9
	LDB 3,[POINT 3,3,20↔POINT 3,3,23↔0↔POINT 3,3,26
	       POINT 3,3,29↔POINT 3,3,32↔POINT 3,3,35](1)
	TDNN 3,0↔POP0J		;AIN'T NO LINK THERE.
	ADD 1,2↔LAC 3,(1)
	TRNN 0,1↔MOVSS 3↔CDR 3
	SKIPE↔DAC QBLK
L:	LAC 1,QBLK↔TEST 1,IBIT↔GO .+3
	DAC 1,QIMAGE↔CALL(DPYIMG)
	CALL(DPYBLK)
	AOS(P)↔POP0J
BEND XLINK; BGB 19 APRIL 1973 ------------------------------------

XCRLFS:	LACI 20↔CRLF↔SOJG .-1↔POP0J
;XRESET "Z" COMMAND.	 NEXIMG.
SUBR(XRESET)------------------------------------------------------
BEGIN XRESET
	EXTERN AVAIL,BLKCNT,FILM,OLD44
	SKIPE META↔GO[SETZB 0,1↔UPGIOT 16,↔POP0J]
	SKIPE CTRL↔GO L
	DZM QBLK↔DZM QIMAGE
	LAC OLD44↔CORE↔JFCL↔DZM OLD44
	DZM AVAIL↔DZM BLKCNT↔DZM FILM
	CALL(MORCOR)
L:	DZM SX↔DZM SY
	LAC[32.0]↔DAC DEL
	LAC[3.4]↔DAC MAG
	CALL(CROP)
	CALL(DPYIMG)
	POP0J
BEND XRESET; BGB 31 DECEMBER 1972 --------------------------------

SUBR(XMOVIE)------------------------------------------------------
BEGIN XMOVIE;NEXT IMAGE - BGB - 11 DEC 72.
	SKIPN 1,QIMAGE↔POP0J
	CCW 2,1↔SKIPE CTRL↔CW 2,1
	DAC 2,QIMAGE
	CALL(DPYIMG)
	SKIPE META↔GO[INCHRS↔GO XMOVIE↔POP0J]
	POP0J
BEND;12/11/72-----------------------------------------------------

SUBR(XMATCH)		"M" - MATCH AND LINK IMAGES IN TIME.
BEGIN XMATCH;-----------------------------------------------------
	EXTERN CMCNII
	LAC CTRL↔AND META↔JUMPN L2
	LAC 2,FILM↔SON 2,2	;FIRST IMAGE TAKEN.
	CW 2,2			;LATEST IMAGE TAKEN.
	LAC 1,2↔CW 1,1		;PENULT IMAGE TAKEN.
	CALL(CMCNII,1,2)	;BEFORE TO AFTER.
	POP0J
L2:	LAC 1,FILM↔SON 1,1
	DAC 1,I0↔DAC 1,I1
L3:	LAC 1,I1↔CCW 2,1		;EARLIER TO LATER.
	CALL(CMCNII,1,2)
	LAC 1,I1↔CCW 1,1↔DAC 1,I1	;ADVANCE ALONG FILM.
	CAME 1,I0↔GO L3↔POP0J
DECLARE{I0,I1}
BEND XMATCH; BGB 16 APRIL 1973 -----------------------------------

XTDPY:;		"←" "→" DISPLAY TIMED LINKED POLYGON OF QBLK.
	EXTERN TIMDPY
	SKIPN 1,QBLK↔POP0J
	TEST 1,PBIT↔POP0J
	PUSH P,QBLK
	LAC CHR↔CAIN "←"↔GO[PUSHJ P,TIMDPY+1↔POP0J]
	PUSHJ P,TIMDPY↔POP0J
SUBR(XNAME)		"N" - NAME THE FILM.
BEGIN XNAME;------------------------------------------------------
	EXTERN STADPY,FNAME,FNAME6
	OUTSTR[ASCIZ/	FILM NAME = /]
	LAC 1,[POINT 7,FNAME,-1]	;ASCII.
	LAC 2,[POINT 6,FNAME6,-1]	;SIXBIT.
	LACI 3,6
L:	INCHWL
	CAIN 15↔GO[INCHWL↔GO EOL]
	CAIL"a"↔SUBI 40
	IDPB 1
	SUBI 40
	IDPB 2
	SOJG 3,L
EOL:	SETZ↔SKIPE 3↔GO[IDPB 1↔IDPB 2↔SOJA 3,.-1]
	CALL(STADPY)
	AOS(P)↔AOS(P)↔POP0J
BEND XNAME; BGB 17 APRIL 1973 ------------------------------------
XFLAGS:
BEGIN XFLAGS;-----------------------------------------------------
	EXTERN ENEST,ECONT,ESMOO,ECOMP

	LAC CHR↔CAIN"E"↔GO L9
	SETZM ENEST↔SETZM ECONT↔SETZM ESMOO↔SETZM ECOMP↔POP0J
L9:	SKIPE MTCT↔EXIT
	SETOM ENEST↔SETOM ECONT↔SETOM ESMOO↔SETOM ECOMP↔POP0J
BEND  XFLAGS; BGB 20 APRIL 1973 ----------------------------------

XINPUT:;			"I" - INPUT COMMANDS.
	EXTERN CREIN,TVDSKI
	SKIPN CTRL↔GO[DZM FLGHIS
	CALL(TVDSKI,[-1])↔GO SKPOPJ]
	CALL(CREIN)
	LAC 1,FILM↔SON 1,1↔DAC 1,QIMAGE
	CALL(DPYIMG)
SKPOPJ:	AOS(P)↔AOS(P)↔POP0J

XOUTPUT:;		"O" - OUTPUT COMMANDS.
	SKIPN CTRL↔GO[
	CALL(TVDSKO↑,[-1])↔GO SKPOPJ]
	CALL(CREOUT↑)↔GO SKPOPJ

SUBR(XCUT).		;MAKE CUTS COMMAND "C".
BEGIN XCUT;-------------------------------------------------------

;DISTINGUISH CUTTING A FILM OF FILES & CUTTING SINGLE IMAGE.
	DZM FFLAG#↔LAC 1,QBLK
	CAMN 1,FILM↔SETOM FFLAG#
	DZM IMGNUM#	;IMAGE NUMBER.

;DECODE THE ARGUMENTS.
	DZM QQ2↔DZM QQ3
L1:	SETZ 1,↔INCHWL
	CAIN 15↔GO[CALL(L4)↔GO L2]
	CAIL 0,"0"↔CAILE 0,"7"↔GO[CALL(L4)↔GO L1]
	IMULI 1,=8↔ANDI 17↔ADD 1,0↔GO L1+1

L2:	INCHWL 			;PICK UP THE LINE FEED.
	SKIPN FFLAG↔GO L3	;SKIP WHEN FILMING.
	CALL(TVDSKI,IMGNUM)
	AOS IMGNUM
	SKIPN 1↔POP0J

L3:	SKIPE META↔GO L5
	LAC QQ2↔IOR QQ3		;MAKE SURE THERE ARE SOME CUTS.
	SKIPN↔POP0J
	CALL(MKCON,QQ2,QQ3)	;CONTOUR THE VIDEO IMAGE.
	CALL(DPYIMG)		;DISPLAY IMAGE.
	SKIPN FFLAG↔POP0J	;POTENTIAL EXIT.
	GO L2+1

;TURN ON SPECIFIED BIT POSITION.
L4:	SKIPN 1↔POP0J
	CAIL 1,=64↔POP0J
	MOVNS 1↔SETZ 3,
	SLACI 2,1B18↔LSHC 2,(1)
	IORM 2,QQ2↔IORM 3,QQ3
	POP0J

;RAW CONTOURS TO XGP.
L5:	SKIPN CTRL↔GO L3+2
	CALL(VICXGP,QQ2,QQ3)↔EXTERN VICXGP
	POP0J
BEND;1/17/73------------------------------------------------------
	DECLARE{QQ2,QQ3}	;CONTOUR CUT INDICATOR BITS.
SUBR(XATP1).	;AUTOMATIC TURN TABLE PERCEPTION "A".
BEGIN ATP1;----------------------------------------------------------
	SKIPE META↔GO XATP2		;META FOR CALIBRATION PASS.
;GET NECESSARY ARGUMENTS.
	DZM IMGNUM#				;IMAGE NUMBER.
	OUTSTR[ASCIZ/	NUMBER OF IMAGES DESIRED = /]
	CALL(REALI↑)↔FIXX↔DAC 1↔MOVM↔AOS↔DAC IMGCNT#

;RESTART AT IMAGE NUMBER <N> WHEN NECESSARY.
	JUMPL 1,[
	OUTSTR[ASCIZ/	FIRST IMAGE'S NUMERAL = /]
	CALL(REALI↑)↔FIXX↔DACM IMGNUM
	LAC 1,IMGCNT↔SUB 1,0↔DAC 1,IMGCNT↔GO .+1]

	CALL(XNAME)↔CRLF			;FILM'S NAME.
	LAC CTRL↔DAC SAVE1#
	DZM CTRL↔DZM META

;PICTURE TAKING LOOP.
L1:	OUTCHR["	"]			;PRINT IMAGE NUMERAL.
	LAC 0,IMGNUM↔IDIVI 0,=10
	ADDI 0,60↔ADDI 1,60
	CAIN 0,"0"↔LACI 0," "
	OUTCHR 0↔OUTCHR 1

	LAC SAVE1↔DAC CTRL
	OUTSTR[ASCIZ/ T/]↔CALL(XTAKE)		;TAKE A PICTURE.
	DZM CTRL

	CALL(TVDSKO,IMGNUM)↔AOS IMGNUM		;OUTPUT THE PICTURE.
	CALL(STADPY)				;STATUS DISPLAY.
	SOSG IMGCNT↔GO L2			;TEST FOR DONE.
	LACI "Y"↔CALL(XTABLE↑)			;TURN THE TABLE.
	GO L1

L2:	OUTSTR[ASCIZ/END OF AUTOMATIC TURN TABLE FILMING.
/]↔	POP0J
BEND ATP1;BGB 25 JUNE 1973 __________________________________________
SUBR(XATP2).	;AUTOMATIC TURN TABLE PERCEPTION "εA".
BEGIN ATP2;----------------------------------------------------------
	DZM META
;GET NECESSARY ARGUMENTS.
	DZM IMGNUM#				;IMAGE NUMBER.
	OUTSTR[ASCIZ/	NUMBER OF IMAGES DESIRED = /]
	CALL(REALI↑)↔FIXX↔DAC 1↔MOVM↔AOS↔DAC IMGCNT#

;RESTART AT IMAGE NUMBER <N> WHEN NECESSARY.
	JUMPL 1,[
	OUTSTR[ASCIZ/	FIRST IMAGE'S NUMERAL = /]
	CALL(REALI↑)↔FIXX↔DACM IMGNUM
	LAC 1,IMGCNT↔SUB 1,0↔DAC 1,IMGCNT↔GO .+1]
	LAC CTRL↔DAC SAVE1#
	DZM CTRL↔DZM META

;PICTURE TAKING LOOP.
L1:	OUTCHR["	"]			;PRINT IMAGE NUMERAL.
	LAC 0,IMGNUM↔IDIVI 0,=10
	ADDI 0,60↔ADDI 1,60
	CAIN 0,"0"↔LACI 0," "
	OUTCHR 0↔OUTCHR 1

	LAC SAVE1↔DAC CTRL
	OUTSTR[ASCIZ/ T/]↔CALL(XTAKE)		;TAKE A PICTURE.
	DZM CTRL↔CRLF

	CALL(MKCON,QQ2,QQ3)↔AOS IMGNUM		;CONTOUR THE IMAGE.
	CALL(DPYIMG)				;STATUS DISPLAY.
	CALL(XMATCH)
	SOSG IMGCNT↔GO L2			;TEST FOR DONE.
	LACI "Y"↔CALL(XTABLE↑)			;TURN THE TABLE.
	GO L1

L2:	OUTSTR[ASCIZ/END OF AUTOMATIC TURN TABLE FILMING.
/]↔	POP0J
BEND ATP2;BGB 25 JUNE 1973 __________________________________________
SUBR(XCUTS).		;MAKE CUTS COMMAND "Q".
BEGIN XCUTS;------------------------------------------------------
	SETZ 1,
	SKIPE CTRL↔LACI 1,1
	SKIPE META↔ADDI 1,2
	CALL(MKCON,{Q1(1)},{Q2(1)})
	CALL(DPYIMG)
	POP0J

;THREE, SEVEN, EIGHT OR FIFTEEN CUTS  -  EQUALLY SPACED.
Q1:	    1B16     +1B32
	1B8+1B16+1B24+1B32  ↔  1B4+1B12+1B20+1B28
	1B8+1B16+1B24+1B32  +  1B4+1B12+1B20+1B28
Q2:	    1B12
	1B4+1B12+1B20 ↔ 1B0+1B8+1B16+1B24
	1B4+1B12+1B20 + 1B0+1B8+1B16+1B24

BEND XCUTS; BGB 9 DECEMBER 1972 -----------------------------------

SUBR(XTAKE).		"T" TAKE TELEVISION PICTURE.
BEGIN XTAKE
	DOM FLGHIS			;HISTOGRAM WILL BE ACCUMULATED.
	LAC CTRL↔AND META↔JUMPN L1	;META-CTRL TAKE A MOVIE.
	SKIPE META↔GO[
	CALL(TVINFB↑)↔POP0J]		;TAKE VIDEO FROM FAST BANDS.

	SKIPE CTRL↔GO[
	CALL(TVIN6↑)↔POP0J]		;CTRL TAKE 6-BIT VIDEO.
	CALL(TVIN4↑)↔POP0J		;TAKE 4-BIT VIDEO

L1:	OUTSTR[ASCIZ/	TAKE FILM/]↔CRLF
	CALL(TVFILM↑)↔POP0J

BEND XTAKE;(BGB)14-DEC-72
SUBR(XSELECT).		"S" SELECT CAMERA.
BEGIN XSELECT;----------------------------------------------------
	EXTERN TVCLIP
	LAC CTRL↔AND META↔SKIPE↔GO L4
	SKIPE CTRL↔GO L2↔SKIPE META↔GO L3

;SELECT CAMERA.
L1:	LDB[POINT 2,TVCLIP,26]↔IORI 60
	OUTSTR[ASCIZ/	CHANGE CAMERA /]
	OUTCHR↔OUTSTR[ASCIZ/ TO /]
	INCHRW↔CAIE 15↔DPB[POINT 2,TVCLIP,26]↔POP0J

;SELECT BOTTOM CLIP LEVEL.
L2:	LDB[POINT 3,TVCLIP,20]↔IORI 60
	OUTSTR[ASCIZ/	CHANGE BCLIP /]
	OUTCHR↔OUTSTR[ASCIZ/ TO /]
	INCHRW↔CAIE 15↔DPB[POINT 3,TVCLIP,20]↔POP0J

;SELECT TOP CLIP LEVEL.
L3:	LDB[POINT 3,TVCLIP,23]↔IORI 60
	OUTSTR[ASCIZ/	CHANGE TCLIP /]
	OUTCHR↔OUTSTR[ASCIZ/ TO /]
	INCHRW↔CAIE 15↔DPB[POINT 3,TVCLIP,23]↔POP0J

;SHRINK NODE SPACE.
L4:	CALL(SHRINK)↔EXTERN SHRINK
	POP0J

BEND XSELECT; BGB 6 DECEMBER 1972 --------------------------------
SUBR(XXPAND);		HISTOGRAM CUT HIGH AND CUT LOW.
BEGIN XXPAND;-----------------------------------------------------
	EXTERN HISTO,HISTOG
	ACCUMULATORS{Q1,Q2,HI,LO}
	SKIPN CTRL↔GO L1
	LACI 1,77↔SETZ↔DAC 0,TVMAP(1)↔AOS↔SOJGE 1,.-2↔GO L3
L1:	CALL(HISTOG)
	LACI HI,77↔DZM LO↔SETZB Q1,Q2
	LACI 6↔IMULI =62208↔IDIVI =100↔DAC 1	;6% RULE.

;COME IN FROM THE EXTREMES 6 PER CENT.
	SETZ↔ADD HISTO(LO)↔CAMGE 1↔AOJA LO,.-2
	SETZ↔ADD HISTO(HI)↔CAMGE 1↔SOJA HI,.-2
L2:	CAML LO,HI↔POP0J

;LOOK FOR LOCAL MINIMUM.
;	LAC HISTO(LO)↔CAML HISTO+1(LO)↔AOJA LO,L2
;	LAC HISTO(LO)↔CAML HISTO-1(LO)↔AOJA LO,L2
;	LAC HISTO(HI)↔CAML HISTO+1(HI)↔SOJA HI,L2
;	LAC HISTO(HI)↔CAML HISTO-1(HI)↔SOJA HI,L2

;MAKE THE TV MAP.
	SETZB 0,1
	DAC 0,TVMAP(1)↔CAMG 1,LO↔AOJA 1,.-2	;00 TO LO → 00.
	LACI 77↔LACI 1,77
	DAC 0,TVMAP(1)↔CAML 1,HI↔SOJA 1,.-2	;77 TO HI → 77.
	SLACI 2,77↔LAC 1,HI↔SUB 1,LO↔IDIV 2,1	;DELTA INTENSITY.
	SETZ↔LAC 1,LO↔AOS 1
	HLRZM 0,TVMAP(1)↔ADD 0,2
	CAMGE 1,HI↔AOJA 1,.-3
L3:	CALL(REMAP)
	POP0J
BEND XXPAND;------------------------------------------------------
SUBR(REMAP);		RE MAP TVBUF.
BEGIN REMAP;------------------------------------------------------
	EXTERN TVBUF,FLGHIS
	DZM FLGHIS
	LAC[XWD L,2]↔BLT 8↔GO 2
L:	ILDB 1,7	;2
	LAC 1,TVMAP(1)	;3 REPLACE BYTE ACCORDING TO TABLE TVMAP.
	DPB 1,7
	SOJG 8,2	;5
	POP0J		;6
	POINT 6,TVBUF	;7 INITIAL TV BUFFER POINTER.
	=62208		;8 NUMBER OF PIXELS.
BEND REMAP; BGB 6 MAY 1973 ----------------------------------------

INTERN TVMAP
TVMAP:	BLOCK 100

;AWIDTH - SELECT ARC WIDTH.
SUBR(AWIDTH)------------------------------------------------------
BEGIN AWIDTH
	EXTERN REALI
	ACCUMULATORS{DEL,XLO,XHI,X1,X2}
	TDCA X2,X2↔INCHWL
L1:	OUTSTR[ASCIZ/	#/]

	INCHRW↔CAIN 15↔GO L1-1
	CAIL"0"↔CAILE"7"↔GO L4
	ANDI 7↔LSH 3↔DAC 1

	INCHRW↔CAIN 15↔GO L1-1
	CAIL"0"↔CAILE"7"↔GO L4
	ANDI 7↔ADD 1,0↔EXCH 1,X2↔DAC 1,X1

L2:	CALL(TYPOUT)↔CALL(REALI)
	JUMPLE .+3↔CAMGE[100.0]↔CALL(ALTER)
	CAIE 1,175↔GO L1↔CRLF↔SOJA X2,L3
L3:	CAILE X2,77↔LACI X2,77
   	CAIGE X2,00↔LACI X2,00
	LAC[ASCIZ/	#00/]
	DPB X2,[POINT 3,0,27]↔ROT X2,-3
	DPB X2,[POINT 3,0,20]↔ROT X2, 3
	OUTSTR↔GO L2
L4:	CRLF↔POP0J

TYPOUT:	LAC ARCWID(X2)↔FMPR[100.0]↔FIXX
	IDIVI 0,=1000
	SKIPE↔IORI"0"↔IORI" "   ↔DPB 0,[POINT 7,STR,13]
	IDIVI 1,=100 ↔IORI 1,"0"↔DPB 1,[POINT 7,STR,20]
	IDIVI 2,=10  ↔IORI 2,"0"↔DPB 2,[POINT 7,STR,34]
	              IORI 3,"0"↔DPB 3,[POINT 7,STR+1,6]
	OUTSTR STR↔POP0J
STR:	ASCIZ/	99.99	/

ALTER:	DAC ARCWID(X2)
	LAC XLO,X1↔LAC XHI,X2↔CAMLE XLO,XHI↔EXCH XLO,XHI
	LAC XHI↔SUB XLO↔FLOAT
	LAC DEL,ARCWID(XHI)↔FSBR DEL,ARCWID(XLO)↔FDVR DEL,0
	LAC ARCWID(XLO)↔AOS XLO
L5:	CAML XLO,XHI↔POP0J
	FADR DEL↔DAC ARCWID(XLO)↔AOJA XLO,L5

BEND AWIDTH;BGB 16 DECEMBER 1972 ---------------------------------
XHELP:	CALL(TVHELP,[[SIXBIT/CRE/↔SIXBIT/HLP/↔0↔SIXBIT/GEM HE/]])
	POP0J
SUBR(TVHELP)FILLOC
BEGIN TVHELP
	EXTERNAL DPYSET,DPYOUT,DPYBIG,DPYBRT,AIVECT,RIVECT,DTYO,DPYBUF
	SETZM INHDR
	INIT 17,↔SIXBIT/DSK/↔INHDR
	GO [FATAL(CAN'T INIT DSK)]
	MOVEI 1,2↔HRL 1,ARG1↔BLT 1,5
	LOOKUP 17,2
	GO [ OUTSTR[ASCIZ/HELP FILE NOT FOUND.
/]↔	     POP1J ]
	PUSH P,121
	PUSH P,44
	MOVE 1,44
	MOVEM 1,121
LOOP:	USETI 17,1
	SETSTS 17,0
	LACI 0,2
	MOVEM 0,PAGNUM#
	SOJLE 0,FOUND
PGLOOP:	CALL(GETCHR)
	GO [ OUTSTR[ASCIZ/PAGE NOT FOUND.
/]↔	     GO RET]
	CAIE 1,14
	JRST PGLOOP
	JRST PGLOOP-1
FOUND:	CALL(DPYSET,DPYBUF)
	CALL(AIVECT,[0],[=440])
	CALL(DPYBIG,[1])
	CALL(DPYBRT,[1])
	SETZM LPOS#
CHLOOP:	CALL(GETCHR)↔GO FIN
	CAIN 1,14↔GO FIN
	CAIN 1,11↔GO [ CALL(DTYO,[40])
	     AOS 1,LPOS
	     TRNE 1,7
	     GO $.-4
	     GO CHLOOP ]
	CALL(DTYO,1)
	AOS LPOS
	MOVE 1,1(P)
	CAIE 1,15
	GO CHLOOP
	SETZM LPOS
	CALL(RIVECT,[1000],[0])
	GO CHLOOP
FIN:	CALL(DPYOUT,[16])
	OUTSTR[ASCIZ/	TYPE <META>Z TO MAKE HELP GO AWAY./]
RET:	RELEASE 17,
	POP P,121
	MOVE 1,121
	CORE 1,↔GO [ FATAL(CAN'T SHRINK CORE) ]
	POP P,121
	POP1J

GETCHR:
	SOSG INHDR+2
	IN 17,↔GO[ILDB 1,INHDR+1↔AOS(P)↔POP0J ]
	POP0J
INHDR:	BLOCK 3
BEND TVHELP
IFE SAIL{END SA}
IFN SAIL{END}